perm filename SAMA.F4[SAM,LCS] blob
sn#437767 filedate 1979-05-01 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C *** MUSIC V FOR PDP11, AS REVISED BY LELAND SMITH ***
C00014 ENDMK
Cā;
C *** MUSIC V FOR PDP11, AS REVISED BY LELAND SMITH ***
C *********** LIMITS ******************
C 15 INST DEFINITIONS. 20 NOTES PLAYING AT ONCE. 27 DIFFERENT INS. NAMES.
DIMENSION T(50),TI(50),ITI(50)
COMMON /DEVS/ID1,ID21,JTYPE,KIN,KOUT
COMMON I(513) /P/P(50) /FINOUT/JPEAK,IPEAK,NBUF
1 /CONV/ICONV,INIOUT,JFLNM
1 /LFUNC/LFUNC,XNFUN,PINCR /IFIRST/IFIRST,IDT
1 /GENS/GENS(3072) /LOCG/LOCG(6)
DO 10 N1=1,NGENS
10 LOCG(N1)=(N1-1)*LFUNC+1
C ABOVE SETS UP 6 POSSIBLE FUNCS. NUMBER MAY BE INCREASED.
C TO INCREASE NUM. OF GENS AVAILABLE ENLARGE 'GENS' BY 512 PER GEN AND
C PUT PROPER NUMBER INTO 'NGENS' DATA AND 'LOCG' ARRAY SIZE.
C ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
DATA ISRT/10000/, LFUNC/512/, CONV/-1/,XNFUN/511.0/
1 ,NPAR/35/,NINS/27/,LBLK/512/,NGENS/6/,PFUNC/512.0/,NLIM/700/
C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
C NLIM=NPAR* HOW MANY NOTES CAN PLAY AT ONCE. (NPAR*20=700, RNT SIZE)
COMMON /INS/INS(300),IDEF(15) /NT/RNT(700) /ROUT/ROUT(2560)
C INS=(15)INSTRUMENT DEFINITIONS: EACH INST. CAN USE 15 TO 40+ SLOTS
C IDEF=LOCATION TABLE: 15 INST. DEFS. POSSIBLE AT ONE TIME.
C RNT=PARAM. LIST FOR CURRENTLY PLAYING NOTES. SIZE OF ARRAY SHOULD
C BE A MULTIPLE OF NPAR (35*20 CURRENTLY=20 NOTES CAN PLAY AT ONCE.)
C ***** ONLY 15 DIFFERENT INS NUMBERS CAN BE USED. (1-15) ********
C ROUT=OUTPUT BLOCK (B1āB5)(5*512=2560)(FITS PDP11/70 FORTRAN.)
EQUIVALENCE (I1,I),(I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3)),
1 (P4,P(4)),(I5,I(5)),(I6,I(6)),(I4,I(4)),(P2,P(2)),(I3,I(3))
C SEE BLOCK DATA FOR DEVICE NUMBERS FOR IN-OUT AND TTY.
NBUF=512
1000 INIOUT=-1
C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
IFIRST=-1
IDT=1
C ABOVE 2 ARE IN TRANS. ROUTINES.
JPEAK=0
IPEAK=0
C IPEAK AND JPEAK USED TO TYPE OUT AMPL. INFO. LATER.
I2=1
IF(I4.EQ.0)I4=ISRT
PINCR=PFUNC/I4
C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
MOUT=1
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220 N1=1,NLIM,NPAR
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
220 RNT(N1)=-1
DO 221 N1=1,NINS
221 TI(N1)=90909.
C MAIN CARD READING LOOP
204 CALL DATA (ID21)
C ID21 IS A DSK DEVICE NUM.
IF(P(1).NE.1.AND.P(1).NE.6)GO TO 200
C JUMP IF A NOTE OR A FINISH
CCC IF(P2.GT.T(1))GO TO 244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALL ERROR(1)
GO TO 204
202 IF(IOP.GT.12)GO TO 201
C ERROR IF OP CODE IS TOO BIG OR <0.
203 GO TO (1,2,3,4,5,6,7,8,201,201,11,11),IOP
11 IVAR=P3
IVARE=IVAR+I1-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
IF(N1.EQ.8)NBUF=512+512*I(N1)
C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
PINCR=PFUNC/I4
C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
GO TO 204
3 IGEN=P3
IF(P4.GT.NGENS)PAUSE ' FUNC. NUM. OUT RANGE'
C ERROR 4=FUNC NUMB. OUT OF RANGE.
IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
CALLGEN2
GO TO 204
7 IF(P4.LT.1)P4=1
C 'SEG' SEG F A,S A,S ... F=FUNC NUM. A=AMPL. S=STEP (1-100)
CCC DO 430 K=4,I1,2
C CONVERT STEPS 1-100 TO 0-511.
CCC430 P(K)=((P(K)-1.)/99.)*511.
530 DO 630 K=I1,1,-1
630 P(K+2)=P(K)
C ABOVE REFORMATS FOR 'GEN' ROUTINES. **NOT FOR SAM5**
P3=IOP-6
P2=0
I1=I1+2
GO TO 3
8 I1=I1+1
C 'SIN' SIN F AH, AH, ... F=FUNC NUM. AH=AMPL OF THAT HARMONIC.
P(I1)=I1-3
C GET TOTAL NUM. OF HARMONICS
GO TO 530
4 IVAR=P3
IVARE=IVAR+I1-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)
GO TO 204
6 CALL FROUT3(IDSK)
CCCC STOP
GO TO 1000
C ENTER NOTE TO BE PLAYED
1 GO TO 231
CCC 1 DO 230 N1=1,NLIM,NPAR
230 IF(RNT(N1).EQ.-1)GO TO 231
CALL ERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
WRITE(JTYPE,1230)NINS
C JTYPE IS TTY DEVICE NUMBER.
GO TO 204
1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
231 M1=1
CC 231 M1=N1
M2=N1+I1-1
M3=M2+1
M4=N1+NPAR-1
DO 232N1=M1,M2
M5=N1-M1+1
232 RNT(N1)=P(M5)
RNT(M1 )=P3
CCC RNT(M1+3)=PINCR/P4
C CONVERTS 'P2' TO PROPER INCREMENT FOR DURATIONS.
IF(M3.GT.M4)GO TO 268
DO 233 N1=M3,M4
233 RNT(N1)=0
GO TO 268
C DEFINE INSTRUMENT
2 M1=I2
M2=IFIX(P3)
IF(M2.GT.15)PAUSE ' ***** INS NUMBER IS TOO HIGH.'
IDEF(M2)=M1
218 CALL DATA (ID21)
IF(I1.GT.2)GO TO 211
210 INS(M1)=0
I2=M1+1
C END OF INST. DEF.
GO TO 204
211 INS(M1)=P3
C P3 IS UNIT GENERATOR CODE NUM.
INS(M1+1)=M1+I1-1
C I1 IS WDCNT OF LAST READIN
M1=M1+2
DO 217N1=4,I1
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 INS(M1)=-1+(M5+101)*LFUNC
GO TO 216
301 INS(M1)=-1+(M5+1)*LBLK
GO TO 216
213 INS(M1)=M5
216 M1=M1+1
217 CONTINUE
GO TO 218
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
268 I3=1
IGEN=RNT(1)
IGEN=IDEF(IGEN)
272 I6=IGEN
294 CALL FORSAM
295 IGEN=INS(IGEN+1)
IF(INS(IGEN))270,270,272
270 RNT(1)=-1
GO TO 204
END
CDATA3 PASS 3 DATA INPUTING ROUTINE
SUBROUTINE DATA (N)
COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK /IFIRST/IFIRST,IDT
COMMON /DEVS/ID1,ID21,JTYPE,KIN,KOUT /JP/JPRNT
EQUIVALENCE (K,I),(P2,P(2))
CALL TRANS(IDT)
IF(JPRNT.LT.0)GO TO 3
C DON'T TYPE BEGIN TIMES IF INPUT IS BEING TYPED OUT. (JPRNT=-1)
IF(P(1).EQ.1)WRITE(JTYPE,1)P2
3 IF(IPEAK.LE.JPEAK)RETURN
WRITE(JTYPE,2)IPEAK
JPEAK=IPEAK
C TYPES OUT EACH NEW PEAK AMPL.
RETURN
1 FORMAT('+',F9.2,$)
2 FORMAT(/' AMPL=',I5,$)
END
SUBROUTINE FROUT3(IDSK)
C TERMINATE OUTPUT
CALL SAMO2(IDSK,-1)
CALL PLAY
END